home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 32 / Mac Magazin and MacEasy Magazine CD - Issue 32.iso / Multimedia / MIDI / MidiChaos_15 Folder / MidiChaos_1.5 / Source / PresetManager < prev    next >
Text File  |  1993-02-26  |  9KB  |  427 lines
  1. \ Preset Manager for MidiChaos
  2. \ Author: Darren Gibbs   Copyright 1990
  3. \ Date:   11/8/90
  4. \
  5. \ MOD: RDG 11/14/90  Added bank load and store.
  6.  
  7. ANEW TASK-PRESET_MANAGER
  8.  
  9. OB.OBJLIST  PRESET-LISTS
  10.  
  11. : BUILD.PRESET.LISTS  ( -- , create shape to hold presets for each voice )
  12.     many: voice-list  dup new: preset-lists  0
  13.     DO
  14.         instantiate ob.shape
  15.         dup 100 19  rot  new: []
  16.         add: preset-lists
  17.     LOOP
  18. ;
  19.  
  20. : FREE.PRESET.LISTS  ( -- , free preset holders )
  21.     many: preset-lists 0
  22.     DO
  23.         I at: preset-lists dup
  24.         free: []
  25.         deinstantiate
  26.     LOOP
  27.     free: preset-lists
  28. ;
  29.  
  30. : GET.VOICE.DATA  { voice# | voice -- , dump voice's data to stack }
  31.     voice# at: voice-list  
  32.     dup -> voice  get.channel: [] 
  33.     get.#params 0 
  34.     DO
  35.         I voice generator@: [] dup>r
  36.          get.p1: []
  37.          r@ get.p2: []
  38.          r@ get.x: []
  39.          r@ get.min: []
  40.          r@ get.max: []
  41.          r> get.function: []
  42.     LOOP
  43. ;    
  44.     
  45. : PUT.VOICE.DATA  ( 19 data items + voice# )  { | voice -- , stuff data into voice }
  46.     at: voice-list -> voice
  47.     get.#params 0 
  48.     DO
  49.         2 I -                              \ count down from two to 0.
  50.         voice generator@: []  dup>r
  51.          use.function: []
  52.          r@ put.max: []
  53.          r@ put.min: []
  54.          r@ put.x: []
  55.          r@ put.p2: []
  56.          r> put.p1: []
  57.     LOOP
  58.     voice put.channel: []
  59. ;    
  60.     
  61.  
  62. OB.NUMERIC.GRID  PRESET-SELECTOR
  63.  
  64. : BUILD.PRESET-SELECTOR  ( -- )
  65.     300 300 put.wh: preset-selector
  66.     1 1 new: preset-selector
  67.     0 0 put.min: preset-selector
  68.     99 0 put.max: preset-selector
  69.     1 put.increment: preset-selector
  70.     " Preset "  put.title: preset-selector
  71. ;
  72.  
  73. : SAVE.PRESET  ( -- )
  74.     pause.voices
  75.     many: voice-list 0 
  76.     DO
  77.         I at: voice-list  get.data: []      \ was the voice on?
  78.         IF  I get.voice.data                 \ dump data onto stack
  79.         ELSE 0 0 0 0 0 0 0 0 0 0 
  80.              0 0 0 0 0 0 0 0 0                 \ 19 dummy values to keep preset 
  81.                                             \   numbers consistant across voices.                                            
  82.         THEN 
  83.              I at: preset-lists dup>r        \ get voice's preset list
  84.              add: []                        \ add new data
  85.              r@ many: []                    \ now how many elements
  86.              1- r> goto: []                    \ update end of list
  87.      LOOP
  88.     0 at: preset-lists where: [] 
  89.     0 put.value: preset-selector              \ update preset-selector    
  90.     unpause.voices
  91. ;    
  92.     
  93. : VALID.PRESET?  ( preset# -- ? )
  94.     0 at: preset-lists  where: []  <=            \ is current <= end of list
  95. ;
  96.     
  97. : LOAD.PRESET  { | preset# -- }
  98.     0 get.value: preset-selector 
  99.     dup -> preset#                                \ get and save preset
  100.     valid.preset?
  101.     IF  many: voice-list 0                         \ for each voice...
  102.         DO
  103.             preset# 0 I at: preset-lists ed.at: []    \ use first as flag
  104.              IF preset#  I at: preset-lists get: []    \ dump data onto stack
  105.                    I put.voice.data                \ write it to the voice    
  106.                 I at: voice-list start: []        \ begin playing
  107.              ELSE I at: voice-list stop: []        \ turn voice off
  108.              THEN     
  109.         LOOP        
  110.     THEN
  111. ;    
  112.     
  113. : INSERT.PRESET  { | preset# -- }
  114.     pause.voices
  115.     0 get.value: preset-selector 
  116.     dup -> preset#                                \ get and save preset
  117.     valid.preset?
  118.     IF    many: voice-list 0 
  119.         DO
  120.             I at: voice-list  get.data: []      \ was the voice on?
  121.             IF  I get.voice.data                 \ dump data onto stack
  122.             ELSE 0 0 0 0 0 0 0 0 0 0 
  123.                  0 0 0 0 0 0 0 0 0                 \ 19 dummy values to keep preset 
  124.                                                 \   numbers consistant across voices.                                            
  125.             THEN preset#                          \ get desired preset location
  126.                    I at: preset-lists             \ get voice's preset list
  127.                    insert: []                        \ insert new data
  128.         LOOP
  129.     THEN
  130.     unpause.voices
  131. ;    
  132.     
  133. : DELETE.PRESET  { | preset#  -- }
  134.     0 get.value: preset-selector 
  135.     dup -> preset#                                \ get and save preset
  136.     valid.preset?
  137.     IF many: voice-list 0 
  138.         DO
  139.             preset#  I at: preset-lists         \ get voice's preset list        
  140.             remove: []                            \ kill it
  141.         LOOP
  142.  
  143.         preset# 0 at: preset-lists many: []  =    \ was this the last in list
  144.         IF 0 get.value: preset-selector
  145.            1- 0 put.value: preset-selector        \ point to new end of list
  146.         THEN
  147.     THEN
  148. ;    
  149.     
  150. : FIRST.PRESET  ( -- )
  151.     0 0 put.value: preset-selector        \ force control to 0
  152.     load.preset
  153.                                 
  154. ;    
  155.  
  156. : LAST.PRESET  ( -- )
  157.     0 at: preset-lists many: [] 1-        \ get last preset
  158.     0 put.value: preset-selector
  159.     load.preset
  160. ;    
  161.     
  162. : NEXT.PRESET  ( -- )
  163.     0 get.value: preset-selector        \ get current preset
  164.     dup 0 at: preset-lists many: [] 1-  \ get last preset
  165.     <
  166.     IF 1+ 0 put.value: preset-selector    \ increment
  167.         load.preset
  168.     ELSE drop                             \ at 0 so use current
  169.     THEN 
  170. ;    
  171.  
  172. : PREV.PRESET  ( -- )
  173.     0 get.value: preset-selector        \ get current preset
  174.     dup 0> 
  175.     IF 1- 0 put.value: preset-selector    \ decrement
  176.         load.preset
  177.     ELSE drop
  178.     THEN                     
  179. ;    
  180.  
  181. : CLEAR.PRESETS  ( -- )
  182.     many: voice-list 0 
  183.     DO
  184.         I at: preset-lists                 \ get voice's preset list
  185.         dup
  186.         clear: []                        \ clear preset list
  187.         reset: []                        \ reset pointer 
  188.     LOOP
  189.     0 0 put.value: preset-selector        \ force control to 0
  190. ;    
  191.     
  192. OB.CHECK.GRID PRESET-GRID
  193. TEXTROM  PRESET-TEXT  ," Save  "  ," Load   " ," Insert " ," Delete "
  194.                       ," First "  ," Last   " ," Next   " ," Prev. "
  195.                       ," Clear "  ," Unused "
  196.                     
  197. CREATE PRESET-FUNCTIONS
  198.     'c save.preset a, 'c load.preset a, 'c insert.preset a, 'c delete.preset a, 
  199.     'c first.preset a,  'c last.preset a, 'c next.preset a, 'c prev.preset a,
  200.     'c clear.presets a, 'c noop a,
  201.                       
  202. : INDEX>PRESET-FUNC  ( index -- CFA , get CFA from index. )    
  203.     preset-functions  swap  cell* +  a@
  204. ;
  205.  
  206. : PRESET.GRID.FUNC  { val part# --  }
  207.     0 at: preset-lists many: [] 0>            \ are there any presets?
  208.     part# 0=                                \ is a save requested?
  209.     OR                                        \ if neither case, do nothing
  210.     IF  part# index>preset-func execute
  211.     THEN
  212.     0 part# current.object put.value: []  \ turn off button
  213. ;
  214.  
  215. : BUILD.PRESET-GRID  ( -- )
  216.     475 300 put.wh: preset-grid
  217.     2 5 new: preset-grid
  218.     'c preset-text put.text.function: preset-grid
  219.     " Options " put.title: preset-grid
  220.     'c preset.grid.func put.down.function: preset-grid
  221. ;
  222.  
  223.  
  224. \ Tools for storing and retrieving preset banks on disk.
  225. 50 CONSTANT PS-PAD-SIZE
  226. VARIABLE PS-PAD     PS-PAD-SIZE ALLOT
  227. VARIABLE PS-INDEX
  228. VARIABLE PS-FILEID
  229.  
  230. : PS-PUSH ( n -- )  
  231.     ps-pad ps-index @ +  W!
  232.     2 ps-index +!
  233. ;
  234.  
  235. : PS-POP ( -- n )  
  236.     ps-index @ 2 - ps-index !        
  237.     ps-pad ps-index @ +  W@
  238. ;
  239.  
  240. : PS.PUSH.PRESET  ( 19items -- )
  241.     0 ps-index !
  242.     19 0 
  243.     DO
  244.         ps-push
  245.     LOOP
  246. ;
  247.  
  248. : PS.POP.PRESET ( -- 19items )  
  249.     38 ps-index !                    \ begin at end of list
  250.     19 0 
  251.     DO
  252.         ps-pop
  253.     LOOP
  254. ;
  255.  
  256. \ FIle words --------------------------------------------------------------        
  257. : $PS.OPEN.VR  ( $filename volref -- )
  258.     $fopen_vr dup 0=
  259.     IF drop abort
  260.     ELSE ps-fileid !
  261.     THEN
  262. ;
  263.  
  264. chkid BUTT PS-CREATOR
  265. chkid TEXT PS-TYPE
  266.  
  267. : PS.SET.FILEINFO  ( -- , set creator and type )
  268.     ps-creator file-creator !
  269.     ps-type    file-type !
  270. ;
  271.  
  272. : $PS.CREATE  ( $filename volref -- , create new file )
  273.     ps.set.fileinfo
  274.     new $ps.open.vr
  275. ;
  276.  
  277. : PS.READ ( addr #bytes --  , read from open ps file)
  278.     ps-fileid @ -rot    fread  drop  \ drop byte count
  279. ;
  280.  
  281. : PS.WRITE ( addr #bytes --  , write to open ps file)
  282.     ps-fileid @ -rot    fwrite  drop  \ drop byte count
  283. ;
  284.  
  285. : PS.CLOSE
  286.     ps-fileid @ ?dup
  287.     IF  fclose
  288.         0 ps-fileid !
  289.     THEN
  290. ;
  291.  
  292. : PS.WRITE.PRESET  ( -- )
  293.     ps-pad 38 ps.write
  294. ;
  295.  
  296. : PS.READ.PRESET  ( -- )
  297.     ps-pad 38 ps.read
  298. ;
  299.  
  300. VARIABLE HEADER-PAD
  301.  
  302. : PS.WRITE.HEADER  ( #voices #presets -- , write data to first to bytes )
  303.     header-pad 1+ c!    
  304.     header-pad c!                
  305.     header-pad 2 ps.write                            
  306. ;
  307.  
  308. : PS.READ.HEADER  ( -- #voices #presets )
  309.     header-pad 2 ps.read
  310.     header-pad c@  header-pad 1+ c@
  311. ;
  312.  
  313. \ Main code. ------------------------------------------------------------
  314. : $SAVE.PRESET ( preset# list# -- )
  315.     at: preset-lists get: []  ps.push.preset
  316.     ps.write.preset
  317. ;
  318.  
  319. : $LOAD.PRESET  { preset# list# -- }
  320.     ps.read.preset
  321.     ps.pop.preset
  322.     list# at: preset-lists  add: []  
  323. ;
  324.  
  325. : (SAVE.BANK)  { #voices #presets -- }
  326.     #voices #presets  ps.write.header
  327.     #voices 0 
  328.     DO
  329.         #presets 0 
  330.         DO
  331.             I J $save.preset
  332.         LOOP
  333.     LOOP
  334. ;
  335.  
  336. : SAVE.BANK  ( -- , save entire set of presets to disk )
  337.     " " 100 100 " " sfputfile
  338.     IF $ps.create
  339.         many: voice-list  0 at: preset-lists many: [] 
  340.         (save.bank)
  341.         ps.close
  342.     THEN
  343. ;
  344.  
  345. : NEW.VOICES ( #voices -- )
  346.     dup many: voice-list =  NOT
  347.     IF term.main.screen
  348.        free.voices
  349.        free.preset.lists
  350.        make.voices
  351.        init.main.screen
  352.        build.preset.lists
  353.     ELSE DROP clear.presets
  354.     THEN
  355. ;
  356.     
  357. : (LOAD.BANK)  { | #presets #voices -- }
  358.     ps.read.header   -> #presets    -> #voices
  359.     #voices new.voices
  360.     #voices 0 
  361.     DO
  362.         #presets 0 
  363.         DO
  364.             I J $load.preset
  365.         LOOP
  366.          #presets 1-                         \ update end of list
  367.         I at: preset-lists goto: []    
  368.     LOOP
  369. ;
  370.  
  371. : LOAD.BANK  ( -- , save entire set of presets to disk )
  372.     sfgetfile
  373.     IF     
  374.         $ps.open.vr
  375.         (load.bank)
  376.         ps.close
  377.     THEN
  378. ;
  379.  
  380. OB.CHECK.GRID BANK-GRID
  381. TEXTROM  BANK-TEXT  ," Save Bank "  ," Load Bank "
  382.  
  383. : BANK.GRID.FUNC  { value part# -- }
  384.     pause.voices
  385.     part#
  386.     CASE
  387.         0 OF save.bank   ENDOF
  388.         1 OF load.bank  ENDOF
  389.     ENDCASE
  390.     0 part# put.value: bank-grid
  391.     unpause.voices
  392. ;
  393.  
  394. : BUILD.BANK-GRID  ( -- )
  395.     650 300 put.wh: bank-grid
  396.     1 2 new: bank-grid
  397.     'c bank-text put.text.function: bank-grid
  398.     'c bank.grid.func put.down.function: bank-grid
  399. ;
  400.  
  401. OB.SCREEN PRESET-SCREEN
  402.  
  403. : BUILD.PRESET.SCREEN  ( -- )
  404.     " Preset Management "  put.title: preset-screen
  405.  
  406.     build.preset-grid
  407.     build.preset-selector
  408.     build.bank-grid
  409.             
  410.     3  3 new: preset-screen
  411.  
  412.     preset-grid                  500     700  add: preset-screen
  413.     preset-selector            1700     700  add: preset-screen
  414.     bank-grid                    1700    1600 add: preset-screen 
  415.  ;
  416.  
  417. : INIT.PRESET.SCREEN  ( -- )
  418.     build.preset.screen
  419.     build.preset.lists
  420. ;
  421.  
  422. : TERM.PRESET.SCREEN  ( -- )
  423.     freeall: preset-screen
  424.     free: preset-screen
  425.     free.preset.lists
  426. ;
  427.